home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / tex / webtp55.zip / ASM2INL.PAS < prev    next >
Pascal/Delphi Source File  |  1989-12-05  |  55KB  |  1,878 lines
  1. {$R-,S-,I-,F-,V-,B-,N-,A+}
  2. Unit Asm2Inl;
  3. {-Convert assembler instructions to inlines}
  4.  
  5.  
  6. { based on the inline assembler in Inline219 by L. David Baldwin
  7.   changed for use with TANGLE, 3.8.89 Peter Sawatzki
  8.  
  9. 28 Vers 2.20 Fix sign extension bug, 4.8.89 PS
  10. ------------ 17-27: L. David Baldwin ---------
  11. 27 Vers 2.19 Fix CMP AX,-1, etc., incorrect in Vers 2.18.
  12. 26 Vers 2.18 Implement the sign extension bit for some instructions
  13. 25 Vers 2.17 Convert to Turbo 4.
  14. 24 Vers 2.16 Change byte size check in MemReg so the likes of
  15.              MOV [DI+$FE],AX will assemble right.
  16.    Allow ',' in DB pseudo op instruction.
  17. 23 Vers 2.15 Fix 'shl cl,1' which assembled as shl cl,cl
  18. 22 Vers 2.14 Change output format to better accomodate map file line numbers.
  19. 21 Vers 2.13 Allow JMP SHORT direct using symbols.
  20. 20 Vers 2.12 Allow CALL and JMP direct using symbols.
  21. 19 Vers 2.11
  22.    Fix bug in CallJmp and ShortJmp which didn't restrict short
  23.    jump range properly.
  24.    Fix bug which didn't allow CALL or JMP register. (CALL BX).
  25. 18 Vers 2.1
  26.    Fix bug in Accum which occasionally messed up IN and OUT instr.
  27.    Fix unintialized function in getnumber for quoted chars.
  28. 17 Vers 2.03
  29.     Change GetSymbol to accept about anything after '>' or '<'
  30.     Add 'NEW' pseudoinstruction.
  31.     Fix serious bug in defaultextension.
  32.     Add Wait_Already to prevent 2 'WAIT's from occuring.
  33.     Use 'tindex<maxbyte' comparison rather than <= which won't work
  34.     with integer comparison in this case.
  35. }
  36.  
  37. Interface
  38. Const
  39.   Maxbyte        = 4000;          {MaxInt}
  40.   InBufMax       = 4000;
  41. Var
  42.   TextArray      : Array[0..Maxbyte] Of Char;
  43.  
  44. Procedure SetupAsm;
  45. Function FeedAsm(Ch : Char) : Boolean;
  46. Function DoAsm(InsertComments : Boolean) : Boolean;
  47. Function ObjSize : Word;
  48.  
  49. Implementation
  50. Const
  51.   Symbolleng     = 32;            {maximum of 32 char symbols}
  52.   CR             = 13; Lf = 10; Tab = 9;
  53.   BigStringSize  = 127;
  54. Type
  55.   SymString      = String[Symbolleng];
  56.   IndxReg        = (BX, SI, DI, BP, None);
  57.   IndxSet        = Set Of IndxReg;
  58.   PtrType        = (BPtr, WPtr, DwPtr, QwPtr, TbPtr, UnkPtr); {keep order}
  59.   String4        = String[4];
  60.   String5        = Array[1..5] Of Char;
  61.   Symtype        = (Address, Disp8, Disp16, Othersym, EOLsym, Identifier, JmpDist,
  62.                     LfBrack, RtBrack, Plus, Comma, STsym);
  63.   BigString      = String[BigStringSize]; {125 chars on a turbo line}
  64.   Label_Info_ptr = ^Label_Info;
  65.   Label_Info     = Record
  66.                      Name           : SymString;
  67.                      ByteCnt        : Integer;
  68.                      Next           : Label_Info_ptr;
  69.                    End;
  70.   Fixup_Info_Ptr = ^Fixup_Info;
  71.   Fixup_Info     = Record
  72.                      Name           : SymString;
  73.                      Indx, Indx2, Fix_pt : Integer;
  74.                      Jmptype        : (Short, Med);
  75.                      Prev, Next     : Fixup_Info_Ptr;
  76.                    End;
  77.  
  78. Var
  79.   InBufEnd       : 0..InBufMax;
  80.   InBuf          : Array[0..InBufMax] Of Char;
  81.   StartChi       : Word;
  82.   EofInstr       : Boolean;
  83.   NoAddrs, Aerr, Symbol, TheEnd, NewFnd, St_first,
  84.   Displace, WordSize, Wait_Already : Boolean;
  85.   Addr           : Integer;
  86.   Sym            : Symtype;
  87.   Reg1, Reg2, W1, W2: byte;
  88.   ModeByte,Sti_val : Integer;
  89.   SaveOfs, DataVal : Record
  90.                        Symb           : Boolean;
  91.                        Sname          : SymString;
  92.                        Value          : Integer;
  93.                      End;
  94.   IRset          : IndxSet;
  95.   Rmm, Md        : Integer;
  96.   ByWord         : PtrType;
  97.   Byt, SignExt   : Byte;
  98.   Tindex, Tindex0, Column, ByteCount, LastSlash : Integer;
  99.  
  100.   TokStr           : SymString;
  101.   UCh, LCh       : Char;
  102.   Chi, OldChi    : Integer;
  103.  
  104.   Start_Col      : Integer;
  105.   Firstlabel, Pl : Label_Info_ptr;
  106.   Firstfix, Pf   : Fixup_Info_Ptr;
  107.  
  108.   Function GetStr(p : Word) : String;
  109.   Var
  110.     s              : String;
  111.   Begin
  112.     s := '';
  113.     Dec(p);
  114.     While (p < InBufEnd) And (InBuf[p] <> '/') Do Begin
  115.       Inc(Byte(s[0]));
  116.       s[Length(s)] := InBuf[p];
  117.       Inc(p);
  118.     End;
  119.     GetStr := s
  120.   End;
  121.  
  122.   Procedure InsertStr(s : BigString); Forward;
  123.  
  124.   Procedure Error(s : BigString);
  125.   Begin
  126.     If Not Aerr Then Begin
  127.       WriteLn;
  128.       WriteLn(GetStr(StartChi));
  129.       Write('':(Start_Col+(Chi-StartChi)),'^Error');
  130.       If Length(s) > 0 Then
  131.         Write(': ', s);
  132.       WriteLn;
  133.       Aerr := True;
  134.       InsertStr('{!Error: '+s+'}'); {-mark error in source file}
  135.     End;
  136.   End;
  137.  
  138.   Procedure SetupAsm;
  139.   Begin
  140.     InBufEnd := 0;
  141.   End;
  142.  
  143.   Function FeedAsm(Ch : Char) : Boolean;
  144.   Begin
  145.     If InBufEnd = InBufMax Then
  146.       FeedAsm := False
  147.     Else Begin
  148.       FeedAsm := True;
  149.       InBuf[InBufEnd] := Ch;
  150.       Inc(InBufEnd)
  151.     End
  152.   End;
  153.  
  154.   {the following are definitions and variables for the parser}
  155. Var
  156.   Segm, NValue   : Integer;
  157.   Symname        : SymString;
  158.   {end of parser defs}
  159.  
  160.   Procedure GetCh;
  161.     {return next char in uch and lch with uch in upper case.}
  162.   Begin
  163.     If Chi < InBufEnd Then Begin
  164.       LCh := InBuf[Chi];
  165.       If LCh = '/' Then
  166.         LCh := Chr(CR);
  167.       UCh := Upcase(LCh);
  168.       Inc(Chi);
  169.     End Else Begin
  170.       LCh := Chr(CR);
  171.       UCh := Chr(CR);
  172.       TheEnd := True
  173.     End;
  174.   End;
  175.  
  176.   Procedure SkipSpaces;
  177.   Begin
  178.     While (UCh = ' ') Or (UCh = Chr(Tab)) Do GetCh;
  179.   End;
  180.  
  181.   Function GetDec(Var V : Integer) : Boolean;
  182.   Const
  183.     Ssize = 8;
  184.   Var
  185.     s: String[Ssize];
  186.     Getd: Boolean;
  187.     Code: Integer;
  188.   Begin
  189.     Getd := False;
  190.     s := '';
  191.     While (UCh >= '0') And (UCh <= '9') Do
  192.       Begin
  193.         Getd := True;
  194.         If Ord(s[0]) < Ssize Then s := s+UCh;
  195.         GetCh;
  196.       End;
  197.     If Getd Then
  198.       Begin
  199.         Val(s, V, Code);
  200.         If Code <> 0 Then Error('Bad number format');
  201.       End;
  202.     GetDec := Getd;
  203.   End;
  204.  
  205.   Function GetHex(Var H : Integer) : Boolean;
  206.   Var
  207.     Digit: Integer; {check for '$' before the call}
  208.   Begin
  209.     H := 0; GetHex := False;
  210.     While (UCh In ['A'..'F', '0'..'9']) Do
  211.       Begin
  212.         GetHex := True;
  213.         If (UCh >= 'A') Then Digit := Ord(UCh)-Ord('A')+10
  214.         Else Digit := Ord(UCh)-Ord('0');
  215.         If H And $F000 <> 0 Then Error('Overflow');
  216.         H := (H Shl 4)+Digit;
  217.         GetCh;
  218.       End;
  219.   End;
  220.  
  221.   Function GetNumber(Var N : Integer) : Boolean;
  222.     {get a number and return it in n}
  223.   Var Term       : Char;
  224.     Err            : Boolean;
  225.   Begin
  226.     N := 0;
  227.     If UCh = '(' Then GetCh;      {ignore ( }
  228.     If (UCh = '''') Or (UCh = '"') Then
  229.       Begin
  230.         GetNumber := True;
  231.         Term := UCh; GetCh; Err := False;
  232.         While (UCh <> Term) And Not Err Do Begin
  233.           Err := N And $FF00 <> 0;
  234.           N := (N Shl 8)+Ord(LCh);
  235.           GetCh;
  236.           If Err Then Error('Overflow')
  237.         End;
  238.         GetCh;                    {use up termination char}
  239.       End
  240.     Else If UCh = '$' Then
  241.       Begin                       {a hex number}
  242.         GetCh;
  243.         If Not GetHex(N) Then Error('Hex number exp');
  244.         GetNumber := True;
  245.       End
  246.     Else
  247.       GetNumber := GetDec(N);     {maybe a decimal number}
  248.     If UCh = ')' Then GetCh;      {ignore an ending parenthesis}
  249.   End;
  250.  
  251.   Function GetExpr(Var Rslt : Integer) : Boolean;
  252.   Var
  253.     Rs1, Rs2, SaveChi : Integer;
  254.     Pos, Neg       : Boolean;
  255.   Begin
  256.     SaveChi := Chi;
  257.     GetExpr := False;
  258.     SkipSpaces;
  259.     Neg := UCh = '-';
  260.     Pos := UCh = '+';
  261.     If Pos Or Neg Then GetCh;
  262.     If GetNumber(Rs1) Then
  263.       Begin
  264.         GetExpr := True;
  265.         If Neg Then Rs1 := -Rs1;
  266.         If (UCh = '+') Or (UCh = '-') Then
  267.           If GetExpr(Rs2) Then
  268.             Inc(Rs1, Rs2);        {getexpr will take care of sign}
  269.         Rslt := Rs1;
  270.       End
  271.     Else
  272.       Begin
  273.         Chi := SaveChi-1; GetCh;
  274.       End;
  275.   End;
  276.  
  277.   {$v+}
  278.   Function GetSymbol(Var s : SymString) : Boolean;
  279.   Const
  280.     Symchars : Set Of Char = ['@'..'Z', '0'..'9', '_', '+', '-', '$', '*'];
  281.   Begin
  282.     If UCh In Symchars Then
  283.       Begin
  284.